home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 1 / Precision Software Applications Silver Collection Volume One (PSM) (1993).iso / children / mazes4.exe / INVMAZE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-24  |  9KB  |  257 lines
  1. PROGRAM invmaze;
  2.   {
  3.          This program will display a maze.  A different random number seed
  4.     will produce a different maze.
  5.  
  6.          Written by James L. Dean
  7.                     406 40th Street
  8.                     New Orleans, LA 70124
  9.   }
  10.   USES Crt;
  11.  
  12.   CONST
  13.  
  14.     num_columns = 79;
  15.     x_max = 158;      {2*num_columns}
  16.     num_rows = 21;
  17.     y_max = 42;       {2*num_rows}
  18.  
  19.   VAR
  20.     delta_index_1              : INTEGER;
  21.     delta_index_1a             : INTEGER;
  22.     delta_index_1b             : INTEGER;
  23.     delta_index_1c             : INTEGER;
  24.     delta_index_1d             : INTEGER;
  25.     delta_index_2              : INTEGER;
  26.     delta_x                    : ARRAY [1..4,1..24] OF INTEGER;
  27.     delta_y                    : ARRAY [1..4,1..24] OF INTEGER;
  28.     digit                      : INTEGER;
  29.     digit_num                  : INTEGER;
  30.     page                       : ARRAY [0..y_max,0..x_max] OF CHAR;
  31.     r_n                        : ARRAY [1..8] OF INTEGER;
  32.     r_n_index_1                : INTEGER;
  33.     r_n_index_2                : INTEGER;
  34.     seed                       : STRING[8];
  35.     sum                        : INTEGER;
  36.     tem_int                    : INTEGER;
  37.     x                          : INTEGER;
  38.     x_next                     : INTEGER;
  39.     x_out                      : INTEGER;
  40.     x_wall_1                   : INTEGER;
  41.     y                          : INTEGER;
  42.     y_next                     : INTEGER;
  43.     y_out                      : INTEGER;
  44.     y_wall_1                   : INTEGER;
  45.  
  46.   PROCEDURE add_room;
  47.     VAR
  48.       delta_index_1 : BYTE;
  49.       delta_index_2 : BYTE;
  50.     BEGIN
  51.       page[y,x]:=' ';
  52.       delta_index_1:=1;
  53.       REPEAT
  54.         delta_index_2:=r_n[1];
  55.         r_n_index_1:=1;
  56.         FOR r_n_index_2:=2 TO 8 DO
  57.           BEGIN
  58.             tem_int:=r_n[r_n_index_2];
  59.             r_n[r_n_index_1]:=tem_int;
  60.             delta_index_2:=delta_index_2+tem_int;
  61.             IF delta_index_2 > 29 THEN
  62.               delta_index_2:=delta_index_2-29;
  63.             r_n_index_1:=r_n_index_2
  64.           END;
  65.         r_n[8]:=delta_index_2
  66.       UNTIL
  67.         (delta_index_2 <= 24);
  68.       WHILE (delta_index_1 <= 4) DO
  69.         BEGIN
  70.           x_next:=x+2*delta_x[delta_index_1][delta_index_2];
  71.           IF ((x_next <= 0) OR (x_next >= x_max)) THEN
  72.             delta_index_1:=delta_index_1+1
  73.           ELSE
  74.             BEGIN
  75.               y_next:=y+2*delta_y[delta_index_1][delta_index_2];
  76.               IF ((y_next <= 0) OR (y_next >= y_max)) THEN
  77.                 delta_index_1:=delta_index_1+1
  78.               ELSE
  79.                 IF page[y_next,x_next] = 'W' THEN
  80.                   BEGIN
  81.                     IF x = x_next THEN
  82.                       BEGIN
  83.                         y_wall_1:=(y+y_next) DIV 2;
  84.                         page[y_wall_1,x_next]:=' '
  85.                       END
  86.                     ELSE
  87.                       BEGIN
  88.                         x_wall_1:=(x+x_next) DIV 2;
  89.                         page[y_next,x_wall_1]:=' '
  90.                       END;
  91.                     x:=x_next;
  92.                     y:=y_next;
  93.                     add_room;
  94.                     x:=x-2*delta_x[delta_index_1][delta_index_2];
  95.                     y:=y-2*delta_y[delta_index_1][delta_index_2]
  96.                   END
  97.                 ELSE
  98.                   delta_index_1:=delta_index_1+1
  99.             END
  100.         END
  101.     END;
  102.  
  103.   BEGIN
  104.     ClrScr;
  105.     WRITELN(OUTPUT,'                                 Maze Generator');
  106.     WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' ');
  107.     WRITE(OUTPUT,'     Random number seed?  ');
  108.     READLN(INPUT,seed);
  109.     r_n_index_1:=1;
  110.     FOR r_n_index_2:=1 TO LENGTH(seed) DO
  111.       BEGIN
  112.         tem_int:=ORD(seed[r_n_index_2]);
  113.         WHILE (tem_int > 29) DO tem_int:=tem_int-29;
  114.         r_n[r_n_index_1]:=tem_int;
  115.         r_n_index_1:=r_n_index_1+1
  116.       END;
  117.     r_n_index_2:=8;
  118.     WHILE (r_n_index_1 > 1) DO
  119.       BEGIN
  120.         r_n_index_1:=r_n_index_1-1;
  121.         r_n[r_n_index_2]:=r_n[r_n_index_1];
  122.         r_n_index_2:=r_n_index_2-1
  123.       END;
  124.     WHILE (r_n_index_2 >= 1) DO
  125.       BEGIN
  126.         r_n[r_n_index_2]:=19;
  127.         r_n_index_2:=r_n_index_2-1
  128.       END;
  129.     delta_x[1,1]:=-1;
  130.     delta_y[1,1]:=0;
  131.     delta_x[2,1]:=0;
  132.     delta_y[2,1]:=1;
  133.     delta_x[3,1]:=1;
  134.     delta_y[3,1]:=0;
  135.     delta_x[4,1]:=0;
  136.     delta_y[4,1]:=-1;
  137.     delta_index_2:=0;
  138.     FOR delta_index_1a:=1 TO 4 DO
  139.       FOR delta_index_1b:=1 TO 4 DO
  140.         IF delta_index_1a <> delta_index_1b THEN
  141.           FOR delta_index_1c:=1 TO 4 DO
  142.             IF ((delta_index_1a <> delta_index_1c)
  143.             AND (delta_index_1b <> delta_index_1c)) THEN
  144.               FOR delta_index_1d:=1 TO 4 DO
  145.                 IF ((delta_index_1a <> delta_index_1d)
  146.                 AND (delta_index_1b <> delta_index_1d)
  147.                 AND (delta_index_1c <> delta_index_1d)) THEN
  148.                   BEGIN
  149.                     delta_index_2:=delta_index_2+1;
  150.                     delta_x[delta_index_1a,delta_index_2]:=delta_x[1,1];
  151.                     delta_y[delta_index_1a,delta_index_2]:=delta_y[1,1];
  152.                     delta_x[delta_index_1b,delta_index_2]:=delta_x[2,1];
  153.                     delta_y[delta_index_1b,delta_index_2]:=delta_y[2,1];
  154.                     delta_x[delta_index_1c,delta_index_2]:=delta_x[3,1];
  155.                     delta_y[delta_index_1c,delta_index_2]:=delta_y[3,1];
  156.                     delta_x[delta_index_1d,delta_index_2]:=delta_x[4,1];
  157.                     delta_y[delta_index_1d,delta_index_2]:=delta_y[4,1]
  158.                   END;
  159.     FOR y_out:=0 TO y_max DO
  160.       FOR x_out:=0 TO x_max DO
  161.         page[y_out,x_out]:='W';
  162.     sum:=0;
  163.     FOR digit_num:=1 TO 3 DO
  164.       BEGIN
  165.         digit:=r_n[1];
  166.         r_n_index_1:=1;
  167.         FOR r_n_index_2:=2 TO 8 DO
  168.           BEGIN
  169.             tem_int:=r_n[r_n_index_2];
  170.             r_n[r_n_index_1]:=tem_int;
  171.             digit:=digit+tem_int;
  172.             IF digit > 29 THEN
  173.               digit:=digit-29;
  174.             r_n_index_1:=r_n_index_2
  175.           END;
  176.         r_n[8]:=digit;
  177.         sum:=29*sum+digit
  178.       END;
  179.     x:=2*(sum MOD num_columns)+1;
  180.     sum:=0;
  181.     FOR digit_num:=1 TO 3 DO
  182.       BEGIN
  183.         digit:=r_n[1];
  184.         r_n_index_1:=1;
  185.         FOR r_n_index_2:=2 TO 8 DO
  186.           BEGIN
  187.             tem_int:=r_n[r_n_index_2];
  188.             r_n[r_n_index_1]:=tem_int;
  189.             digit:=digit+tem_int;
  190.             IF digit > 29 THEN
  191.               digit:=digit-29;
  192.             r_n_index_1:=r_n_index_2
  193.           END;
  194.         r_n[8]:=digit;
  195.         sum:=29*sum+digit
  196.       END;
  197.     y:=2*(sum MOD num_rows)+1;
  198.     add_room;
  199.     page[0,1]:=' ';
  200.     page[y_max,x_max-1]:=' ';
  201.     ClrScr;
  202.     y:=1;
  203.     WHILE (y <= y_max) DO
  204.       BEGIN
  205.         x:=1;
  206.         WHILE (x <= x_max) DO
  207.           BEGIN
  208.             IF page[y,x-1] <> 'W' THEN
  209.               IF page[y-1,x] <> 'W' THEN
  210.                 IF page[y+1,x] <> 'W' THEN
  211.                   IF page[y,x+1] <> 'W' THEN
  212.                     WRITE(OUTPUT,CHR(206))
  213.                   ELSE
  214.                     WRITE(OUTPUT,CHR(185))
  215.                 ELSE
  216.                   IF page[y,x+1] <> 'W' THEN
  217.                     WRITE(OUTPUT,CHR(202))
  218.                   ELSE
  219.                     WRITE(OUTPUT,CHR(188))
  220.               ELSE
  221.                 IF page[y+1,x] <> 'W' THEN
  222.                   IF page[y,x+1] <> 'W' THEN
  223.                     WRITE(OUTPUT,CHR(203))
  224.                   ELSE
  225.                     WRITE(OUTPUT,CHR(187))
  226.                 ELSE
  227.                   IF page[y,x+1] <> 'W' THEN
  228.                     WRITE(OUTPUT,CHR(205))
  229.                   ELSE
  230.                     WRITE(OUTPUT,CHR(181))
  231.             ELSE
  232.               IF page[y-1,x] <> 'W' THEN
  233.                 IF page[y+1,x] <> 'W' THEN
  234.                   IF page[y,x+1] <> 'W' THEN
  235.                     WRITE(OUTPUT,CHR(204))
  236.                   ELSE
  237.                     WRITE(OUTPUT,CHR(186))
  238.                 ELSE
  239.                   IF page[y,x+1] <> 'W' THEN
  240.                     WRITE(OUTPUT,CHR(200))
  241.                   ELSE
  242.                     WRITE(OUTPUT,CHR(208))
  243.               ELSE
  244.                 IF page[y+1,x] <> 'W' THEN
  245.                   IF page[y,x+1] <> 'W' THEN
  246.                     WRITE(OUTPUT,CHR(201))
  247.                   ELSE
  248.                     WRITE(OUTPUT,CHR(210))
  249.                 ELSE
  250.                   WRITE(OUTPUT,CHR(198));
  251.             x:=x+2
  252.         END;
  253.         y:=y+2;
  254.         WRITELN(OUTPUT)
  255.       END
  256.   END.
  257.